home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / electric.tcl < prev    next >
Text File  |  1996-08-15  |  9KB  |  310 lines
  1. ########################################################################
  2. # Mode-dependent auto-indentation
  3. # (modified from original generic indentLine by Tom Pollard 
  4. # <pollard@chem.columbia.edu>)
  5. #
  6. # 1. 'indentLine' calls the routine ${mode}indentLine, if it exists, 
  7. #      else it reverts to Pete's generic indentLine procedure.
  8. # 2. 'indentRegion' calls the routine ${mode}indentRegion, if it 
  9. #       exists, else it reverts to calling 'indentLine' for each line.
  10. # 3. generic indentLine uses mode-specific comment definition, if it 
  11. #       exists. (defined below for Tcl, Perl, and C)
  12. #
  13.  
  14. # Called at all carriage returns.
  15. proc carriageReturn {} {
  16.     global mode
  17.     global indentOnCR
  18.     set indentString ""
  19.     deleteText [getPos] [selEnd]
  20.     if {$indentOnCR} {
  21.         set pos [getPos]
  22.         set text [getText [lineStart $pos] $pos]
  23.         for {set i 0; set len [string length $text]} {$i <= $len} {incr i} {
  24.             set c [string index $text $i]
  25.             if {($c != "¥t") && ($c != "¥ ")} {
  26.                 set indentString [string range $text 0 [expr $i-1]]
  27.                 break
  28.             }
  29.         }
  30.     }
  31.     insertText "¥r" $indentString
  32. }
  33.  
  34. # doATab may be called with an optional non-zero argument to override
  35. # its interpretation as 'indent-Line' (doesn't break older usage.)
  36. proc doATab {{hard 0}} {
  37.     global mode
  38.     global ${mode}modeVars
  39.     if {$hard || ([info exists ${mode}modeVars] && 
  40.                   ![set ${mode}modeVars(electricTab)])} {
  41.         if {[getPos] != [selEnd]} {
  42.             replaceText [getPos] [selEnd] "¥t"
  43.         } else {
  44.             insertText "¥t"
  45.         }
  46.     } else {
  47.         indentLine
  48.     }
  49. }
  50.  
  51. proc indentLine {} {
  52.     global mode    
  53.     if {[catch {${mode}indentLine}]} {
  54.         indentLine0
  55.     }    
  56. }
  57.  
  58. proc indentRegion {} {
  59.     global mode    
  60.     if {[catch {${mode}indentRegion}]} {
  61.         simpleIndentRegion
  62.     }
  63. }
  64.  
  65. proc simpleIndentRegion {} {
  66.     set from [lindex [posToRowCol [getPos]] 0]
  67.     set to [lindex [posToRowCol [selEnd]] 0]
  68.     select [getPos]
  69.     while {$from <= $to} {
  70.         goto [rowColToPos $from 0]
  71.         indentLine
  72.         incr from
  73.     }
  74. }
  75.  
  76. set TclcommentRegexp {^[ ¥t]*#}
  77. set PerlcommentRegexp {^[ ¥t]*#}
  78. set cCommentRegexp    {/¥*([^*]|[^*]¥/|¥*[^¥/]|¥r)*¥*/}
  79. set CcommentRegexp $cCommentRegexp
  80. set C++commentRegexp $cCommentRegexp
  81.  
  82. ########################################################################
  83. # Generic C-style indentation (works for Tcl and Perl)
  84. #
  85. proc indentLine0 {} {
  86.     global mode 
  87.     global ${mode}commentRegexp cCommentRegexp
  88.     
  89.     if {[info exists ${mode}commentRegexp]} {
  90.         set comPat [set ${mode}commentRegexp]
  91.     } else {
  92.         set comPat $cCommentRegexp
  93.     }
  94.     set comPat "($comPat|^¥[     ¥]¥[    ¥]*¥$)"
  95.     
  96.     set beg [lineStart [getPos]]
  97.     set end [nextLineStart [getPos]]
  98.  
  99.     # Find last previous non-comment line and get its leading whitespace
  100.     set pos $beg
  101.     set lst [search -s -f 0 -r 1 -i 0 {^[ ¥t]*[^ ¥t¥r]} [expr $pos-1]]    
  102.     set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
  103.     set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  104.     # Find the last preceding comment block
  105.     set prvPos [lindex $lst 0]
  106.     if {![catch {search -s -f 0 -r 1 -i 0 $comPat [expr $pos-1]} lstCmt]} {
  107.         set begCmt [lindex $lstCmt 0]
  108.         set endCmt [lindex $lstCmt 1]
  109.         # If current non-blank line is in the comment...
  110.         while {$begCmt <= $prvPos && $endCmt >= $prvPos} {
  111.             # ...find the last non-blank line that precedes the comment block,
  112.             if {![catch {search -s -f 0 -r 1 -i 0 {^[ ¥t]*[^ ¥t¥r]} [expr $begCmt-1]} lst]} {    
  113.                 set prvPos [lindex $lst 0]
  114.                 set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
  115.                 set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  116.                 # ...and the next preceding comment block.
  117.                 if {![catch {search -s -f 0 -r 1 -i 0 $comPat [expr $prvPos]} lstCmt]} {
  118.                     set begCmt [lindex $lstCmt 0]
  119.                     set endCmt [lindex $lstCmt 1]
  120.                 } else {
  121.                     break
  122.                 }
  123.             } else {
  124.                 # Handle search failure at top-of-file
  125.                 set line "#"
  126.                 set lwhite ""
  127.                 break
  128.             }
  129.         }
  130.     }
  131.  
  132. #   This line fails if there's whitespace at the end of the previous line
  133. #    set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
  134. #
  135. #    set line [getText [lindex $lst 0] [expr [nextLineStart [lindex $lst 0]] - 1]]
  136. #
  137.     regexp {([^ ¥t])[ ¥t]*$} $line allofit nextC
  138. #
  139.     if {($nextC == "¥{")} {
  140.         append lwhite "¥t"
  141.     } elseif {$nextC == ":"} {
  142.         set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]¥t"
  143.     }
  144.         
  145.     set text [getText $beg [nextLineStart $beg]]
  146.     regexp {^[ ¥t]*} $text white
  147.     set len [string length $white]
  148.     set nextC [lookAt [expr $beg + $len]]
  149.     if {$nextC == "¥}"} {
  150.         set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
  151.     }
  152.  
  153.     if {$white != $lwhite} {
  154.         replaceText $beg [expr $beg + $len] $lwhite
  155.     }
  156.     goto [expr $beg + [string length $lwhite]]
  157. }
  158.  
  159. ########################################################################
  160. # Pete's generic indentLine from v6.02
  161. #
  162. proc C++indentLine {} { CindentLine }
  163. proc CindentLine {} {
  164.     global mode
  165.     
  166.     set beg [lineStart [getPos]]
  167.  
  168.     set lst [search -s -f 0 -r 1 -i 0 {^[ ¥t]*[^ ¥t¥r]} [expr $beg-1]]
  169.     set lwhite [getText [lindex $lst 0] [expr [lindex $lst 1] - 1]]
  170.     set nextC [lookAt [expr [nextLineStart [lindex $lst 1]] - 2]]
  171.  
  172.     if {($nextC == "¥{")} {
  173.         append lwhite "¥t"
  174.     } elseif {$nextC == ":"} {
  175.         set lwhite "[string range $lwhite 0 [expr [string length $lwhite]-3]]¥t"
  176.     }
  177.         
  178.     set text [getText $beg [nextLineStart $beg]]
  179.     regexp {^[ ¥t]*} $text white
  180.     set len [string length $white]
  181.     set nextC [lookAt [expr $beg + $len]]
  182.     if {$nextC == "¥}"} {
  183.         set lwhite [string range $lwhite 0 [expr [string length $lwhite] - 2]]
  184.     }
  185.     
  186.     global ${mode}modeVars
  187.     if {[string match "*:¥r" $text] && [info exists ${mode}modeVars(elecColon)] && [set ${mode}modeVars(elecColon)]} {
  188.         if {[string index $lwhite 0] == "¥t"} {
  189.             set lwhite "[string range $lwhite 1 [expr [string length $lwhite] - 1]]  "
  190.         }
  191.     }
  192.  
  193.     if {$white != $lwhite} {
  194.         replaceText $beg [expr $beg + $len] $lwhite
  195.     }
  196.     goto [expr $beg + [string length $lwhite]]
  197. }
  198.  
  199. ########################################################################
  200. #===============================================================================
  201. proc electricLeft {} {
  202.     global mode
  203.     global ${mode}modeVars
  204.     deleteText [getPos] [selEnd]
  205.     if {![set ${mode}modeVars(elecLBrace)]} then {
  206.         insertText "¥{"
  207.         return
  208.     }
  209.     if {[set ${mode}modeVars(elecLBrace)] && ![catch {search -l [lineStart [expr [lineStart [getPos]] - 1]] -s -f 0 -r 0 "¥}" [getPos]} res]} {
  210.         set end [getPos]
  211.         if {[getPos] != [maxPos]} {
  212.             incr end
  213.         }
  214.         
  215.         if {[regexp {¥}[ ¥t¥r]*else} [getText [lindex $res 0] $end]]} {
  216.             set res2 [search -f 0 -r 0 {else} [getPos]]
  217.             oneSpace
  218.             set text [getText [lindex $res2 0] [getPos]]
  219.             if {[lookAt [expr [getPos] - 1]] != " "} {
  220.                 append text " "
  221.             }
  222.             replaceText [expr [lindex $res 0] + 1] [getPos] " $text¥{¥r"
  223.             indentLine
  224.             return
  225.         }
  226.     }
  227.     set pos [getPos]
  228.     set start [lineStart $pos]
  229.     set text [getText $start $pos]
  230.     
  231.     for {set i $start} {$i < $pos} {incr i} {
  232.         set c [lookAt $i]
  233.         if {($c != "¥ ") && ($c != "¥t")} then {
  234.             break;
  235.         }
  236.     }
  237.     set indentation [getText $start $i]
  238.     if {($i == $pos) || ([lookAt [expr $pos - 1]] == " ")} {
  239.         insertText "¥{¥r" $indentation "¥t"
  240.     } else {
  241.         insertText " ¥{¥r" $indentation "¥t"
  242.     }
  243. }
  244.  
  245. proc electricRight {} {
  246.     global mode
  247.     global ${mode}modeVars
  248.     
  249.     deleteText [getPos] [selEnd]
  250.     if {[set ${mode}modeVars(elecRBrace)] == "0"} then {
  251.         insertText "¥}"
  252.         catch {blink [matchIt "¥}" [expr [getPos]-2]]}
  253.         return
  254.     }
  255.     set pos [getPos]
  256.     set start [lineStart $pos]
  257.     
  258.     if {[catch {matchIt "¥}" [expr $pos-1]} matched]} {
  259.         beep
  260.         return
  261.     }
  262.     set text [getText [lineStart $matched] $matched]
  263.     regexp {^[     ]*} $text indentation
  264.     for {set i $start} {$i < $pos} {incr i} {
  265.         set c [lookAt $i]
  266.         if {($c != "¥ ") && ($c != "¥t")} then {
  267.             insertText "¥r" $indentation "¥}¥r" $indentation
  268.             blink $matched
  269.             return
  270.         }
  271.     }
  272.     set text [set indentation]¥}¥r$indentation
  273.     replaceText $start $pos $text
  274.     goto [expr {$start + [string length $text]}]
  275.     blink [matchIt "¥}" [expr $start-2]]
  276. }
  277.  
  278. proc electricSemi {} {
  279.     global mode
  280.     global ${mode}modeVars
  281.     deleteText [getPos] [selEnd]
  282.     if {[set ${mode}modeVars(electricSemi)] == "0"} then {
  283.         insertText ";"
  284.         return
  285.     }
  286.     set pos [getPos]
  287.     set start [lineStart $pos]
  288.     set text [getText $start $pos]
  289.     
  290.     if {[string first "for" $text] != "-1"} {
  291.         set lefts 0
  292.         set rights 0
  293.         set len [string length $text]
  294.         for {set i 0} {$i < $len} {incr i} {
  295.             case [string index $text $i] in {
  296.                 "("    { incr lefts }
  297.                 ")"    { incr rights }
  298.             }
  299.         }
  300.         global globs
  301.         set globs [list $lefts $rights $len]
  302.         if {$lefts != $rights} {
  303.             insertText ";"
  304.             return
  305.         }
  306.     }
  307.     
  308.     insertText ";¥r" [indentString $pos]
  309. }
  310.